home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / vgfx10.zip / DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1994-12-01  |  33KB  |  1,161 lines
  1. { VGFX Demo Program v1.00 - (C) Copyright 1994 Bill Quesnel }
  2.  
  3. program VGFX_Demo;
  4.  
  5.  
  6. uses VGFX, crt, dos;
  7.  
  8. {$I vgfx.inc}
  9.  
  10. { Declare our memory needed for sprites }
  11. type
  12.     celA = array[1..195] of byte;
  13.     celB = array[1..525] of byte;
  14.     celC = array[1..891] of byte;
  15.     guyc = array[1..975] of byte;
  16.     tree = array[1..6059] of byte;
  17.  
  18. { Misc. demo variables }
  19. var
  20.    cel1  : ^celA;
  21.    cel2  : ^celB;
  22.    cel3  : ^celC;
  23.    tmp   : integer;
  24.    x, y  : integer;
  25.    key   : char;
  26.    man   : array[1..8] of ^guyc;
  27.    btree : ^tree;
  28.  
  29.  
  30.  
  31. { Do Ball demo #1 }
  32. { - - - - - - }
  33. Procedure Ball1;
  34. Var
  35.    x, y : array[1..25] of integer;
  36.    hit  : array[1..25] of byte;
  37.    hitY : array[1..25] of byte;
  38.    m    : byte;
  39.    c    : char;
  40.    FOut,
  41.    Quit,
  42.    FIn  : Boolean;
  43.  
  44. Begin
  45.      { Set palette to black }
  46.      BlankPalette;
  47.  
  48.      { Load up our images }
  49.      ShowPcx ('balls.pcx', 1, 1);
  50.  
  51.      { Get images into memory }
  52.      SetWorkPage(1);
  53.      GetImage (cel1^, 10, 7, 15, 13);
  54.      GetImage (cel2^, 45, 7, 25, 21);
  55.      GetImage (cel3^, 96, 7, 33, 27);
  56.  
  57.      { Load up our background fractal }
  58.      ShowPcx ('frac.pcx', 1, 1);
  59.  
  60.      { Initialize the mouse driver }
  61.      MInit;
  62.  
  63.      { Fade-in the screen }
  64.      FadeIn (1, 1, 0);
  65.  
  66.  
  67.      { Make the mouse cursor visible }
  68.      MShow (1);
  69.      FOut := FALSE;
  70.  
  71.      for tmp := 1 to 25 do
  72.      begin
  73.           x[tmp]   := random(300);
  74.           y[tmp]   := random(175);
  75.           hit[tmp] := random(2);
  76.           hitY[tmp]:= random(2);
  77.      end;  { end for\do }
  78.  
  79.      FOut := FALSE;
  80.      FIn  := FALSE;
  81.      Quit := FALSE;
  82.  
  83.      { Set VGFX's visual page to 1 }
  84.      SetWorkPage(1);
  85.      FlushKB;
  86.  
  87.      repeat
  88.            { All of the FOR/DO loops from here on are checking the ball's
  89.              boundaries and moving them accordingly }
  90.  
  91.            for m := 1 to 5 do
  92.            begin
  93.                 if (x[m] > 274) then hit[m] := 0;
  94.                 if (x[m] < 1)   then hit[m] := 1;
  95.                 if (y[m] > 186) then hitY[m]:= 0;
  96.                 if (y[m] < 1)   then hitY[m]:= 1;
  97.  
  98.                 Case hit[m] of
  99.                      1 : inc(x[m],2);
  100.                      0 : dec(x[m],2);
  101.                 end; { end case }
  102.  
  103.                 Case hitY[m] of
  104.                      1 : inc(y[m],2);
  105.                      0 : dec(y[m],2);
  106.                 end; { end case }
  107.            end;  { end for\do }
  108.  
  109.            for m := 6 to 10 do
  110.            begin
  111.                 if (x[m] > 274) then hit[m] := 0;
  112.                 if (x[m] < 1)   then hit[m] := 1;
  113.                 if (y[m] > 186) then hitY[m]:= 0;
  114.                 if (y[m] < 1)   then hitY[m]:= 1;
  115.  
  116.                 Case hit[m] of
  117.                      1 : inc(x[m],1);
  118.                      0 : dec(x[m],1);
  119.                 end; { end case }
  120.  
  121.                 Case hitY[m] of
  122.                      1 : inc(y[m],1);
  123.                      0 : dec(y[m],1);
  124.                 end; { end case }
  125.            end;  { end for\do }
  126.  
  127.            for m := 11 to 14 do
  128.            begin
  129.                 if (x[m] > 294) then hit[m] := 0;
  130.                 if (x[m] < 1)   then hit[m] := 1;
  131.                 if (y[m] > 179) then hitY[m]:= 0;
  132.                 if (y[m] < 1)   then hitY[m]:= 1;
  133.  
  134.                 Case hit[m] of
  135.                      1 : inc(x[m],1);
  136.                      0 : dec(x[m],1);
  137.                 end; { end case }
  138.  
  139.                 Case hitY[m] of
  140.                      1 : inc(y[m],1);
  141.                      0 : dec(y[m],1);
  142.                 end; { end case }
  143.            end;  { end for\do }
  144.  
  145.            for m := 15 to 18 do
  146.            begin
  147.                 if (x[m] > 294) then hit[m] := 0;
  148.                 if (x[m] < 1)   then hit[m] := 1;
  149.                 if (y[m] > 179) then hitY[m]:= 0;
  150.                 if (y[m] < 1)   then hitY[m]:= 1;
  151.  
  152.                 Case hit[m] of
  153.                      1 : inc(x[m],2);
  154.                      0 : dec(x[m],2);
  155.                 end; { end case }
  156.  
  157.                 Case hitY[m] of
  158.                      1 : inc(y[m],2);
  159.                      0 : dec(y[m],2);
  160.                 end; { end case }
  161.            end;  { end for\do }
  162.  
  163.            for m := 19 to 21 do
  164.            begin
  165.                 if (x[m] > 294) then hit[m] := 0;
  166.                 if (x[m] < 1)   then hit[m] := 1;
  167.                 if (y[m] > 179) then hitY[m]:= 0;
  168.                 if (y[m] < 1)   then hitY[m]:= 1;
  169.  
  170.                 Case hit[m] of
  171.                      1 : inc(x[m],4);
  172.                      0 : dec(x[m],4);
  173.                 end; { end case }
  174.  
  175.                 Case hitY[m] of
  176.                      1 : inc(y[m],4);
  177.                      0 : dec(y[m],4);
  178.                 end; { end case }
  179.            end;  { end for\do }
  180.  
  181.            for m := 22 to 25 do
  182.            begin
  183.                 if (x[m] > 286) then hit[m] := 0;
  184.                 if (x[m] < 1)   then hit[m] := 1;
  185.                 if (y[m] > 172) then hitY[m]:= 0;
  186.                 if (y[m] < 1)   then hitY[m]:= 1;
  187.  
  188.                 Case hit[m] of
  189.                      1 : inc(x[m],3);
  190.                      0 : dec(x[m],3);
  191.                 end; { end case }
  192.  
  193.                 Case hitY[m] of
  194.                      1 : inc(y[m],3);
  195.                      0 : dec(y[m],3);
  196.                 end; { end case }
  197.            end;  { end for\do }
  198.  
  199.  
  200.            { Put the images on the screen!  All balls in this block will
  201.              be behind the text }
  202.            PutClip(cel1^, x[1], y[1], 15, 13);
  203.            PutClip(cel1^, x[2], y[2], 15, 13);
  204.            PutClip(cel1^, x[3], y[3], 15, 13);
  205.            PutClip(cel1^, x[4], y[4], 15, 13);
  206.            PutClip(cel1^, x[5], y[5], 15, 13);
  207.            PutClip(cel1^, x[6], y[6], 15, 13);
  208.            PutClip(cel1^, x[7], y[7], 15, 13);
  209.            PutClip(cel1^, x[8], y[8], 15, 13);
  210.            PutClip(cel1^, x[9], y[9], 15, 13);
  211.            PutClip(cel1^, x[10], y[10], 15, 13);
  212.            PutClip(cel2^, x[11], y[11], 25, 21);
  213.            PutClip(cel2^, x[12], y[12], 25, 21);
  214.            PutClip(cel2^, x[13], y[13], 25, 21);
  215.            PutClip(cel2^, x[14], y[14], 25, 21);
  216.            PutClip(cel3^, x[25], y[25], 33, 27);
  217.  
  218.            { Print our little message to the screen }
  219.            VPrint ('Q to Quit', 10, 153, 15, 255);
  220.            VPrint ('O to fade out', 10, 163, 9, 255);
  221.            VPrint ('I to fade in', 10, 173, 1, 255);
  222.            VPrint ('S to stop fade', 10, 183, 9, 255);
  223.  
  224.            { Now put somemore images to the screen, All balls in this block
  225.              will be infront of the text }
  226.            PutClip(cel2^, x[15], y[15], 25, 21);
  227.            PutClip(cel2^, x[16], y[16], 25, 21);
  228.            PutClip(cel2^, x[17], y[17], 25, 21);
  229.            PutClip(cel2^, x[18], y[18], 25, 21);
  230.            PutClip(cel2^, x[19], y[19], 25, 21);
  231.            PutClip(cel2^, x[20], y[20], 25, 21);
  232.            PutClip(cel2^, x[21], y[21], 25, 21);
  233.            PutClip(cel3^, x[22], y[22], 33, 27);
  234.            PutClip(cel3^, x[23], y[23], 33, 27);
  235.            PutClip(cel3^, x[24], y[24], 33, 27);
  236.  
  237.            { Update the mouse cursor, if you don't call this the mouse
  238.              will not be updated correctly! }
  239.            MMove;
  240.  
  241.            { Now update the screen with all of our new stuff }
  242.            Update;
  243.  
  244.  
  245.            { Now check for user activity }
  246.            if (keypressed) then
  247.            begin
  248.                 c := upcase(readkey);
  249.  
  250.                 case c of
  251.                      'Q': Quit := TRUE;
  252.                      'S': begin
  253.                                FOut := FALSE;
  254.                                FIn := FALSE;
  255.                           end;
  256.                      'O': begin
  257.                                FIn := FALSE;
  258.                                if (FOut) then FOut := FALSE
  259.                                   else FOut := TRUE;
  260.                           end;
  261.                      'I': begin
  262.                                FOut := FALSE;
  263.                                if (FIn) then FIn := FALSE
  264.                                   else FIn := TRUE;
  265.                           end;
  266.                 end; { end case }
  267.            end;
  268.  
  269.            If (FOut) then FadeOutStep (1, 0, 0);
  270.            If (FIn) then FadeInStep (1, 0, 0);
  271.  
  272.      until (Quit = TRUE);
  273.  
  274.      { Fade-out the screen }
  275.      FadeOut (1, 1, 0);
  276.  
  277.      { Clear both video pages }
  278.      SetWorkPage (1);
  279.      clearscreen (0);
  280.      SetWorkPage (2);
  281.      clearscreen (0);
  282.  
  283. End;  { Procedure }
  284.  
  285.  
  286. { Do Balls demo #2 }
  287. { - - - - - - }
  288. Procedure Ball2;
  289. const
  290.      maxstars = 100;
  291.  
  292. Var
  293.    x, y  : array[1..25] of integer;
  294.    hit,
  295.    hitY  : array[1..25] of byte;
  296.    stars : array[0..200] of array[0..3] of integer;
  297.    c     : char;
  298.    m,
  299.    scolor: byte;
  300.    Quit,
  301.    FOut,
  302.    FIn   : Boolean;
  303.    i,
  304.    speed : integer;
  305.  
  306. Begin
  307.      { Set palette to black }
  308.      BlankPalette;
  309.  
  310.      SetWorkPage(1);
  311.  
  312.      { Load-up our images }
  313.      ShowPcx ('balls.pcx', 1, 1);
  314.  
  315.      { Get images into memory }
  316.      GetImage (cel1^, 10, 7, 15, 13);
  317.      GetImage (cel2^, 45, 7, 25, 21);
  318.      GetImage (cel3^, 96, 7, 33, 27);
  319.  
  320.      { Clear the video page }
  321.      SetWorkPage (1);
  322.      clearscreen (0);
  323.  
  324.      FOut := FALSE;
  325.  
  326.      for tmp := 1 to 25 do
  327.      begin
  328.           x[tmp] := random(300);
  329.           y[tmp] := random(175);
  330.           hit[tmp] := random(2);
  331.           hitY[tmp] := random(2);
  332.      end;  { end for\do }
  333.  
  334.      speed := 5;
  335.  
  336.      { Init stars }
  337.      for i := 0 to maxstars do
  338.      begin
  339.           stars[i,0] := random(319);
  340.           stars[i,1] := random(199);
  341.  
  342.           { Star Speed }
  343.           stars[i,3] := random(speed) + 1;
  344.  
  345.           case stars[i,3] of
  346.                1 : stars[i,2] := 26 + random(5);
  347.                2 : stars[i,2] := 23 + random(5);
  348.           else
  349.               stars[i,2] := 18 + random(5);
  350.           end;  { end case }
  351.      end;  { end for\do }
  352.  
  353.      FOut := FALSE;
  354.      FIn  := FALSE;
  355.      Quit := FALSE;
  356.  
  357.  
  358.      { Initialize and show mouse }
  359.      MInit;
  360.      MShow (1);
  361.  
  362.      { Restore palette to normal }
  363.      RestorePalette;
  364.      FlushKB;
  365.  
  366.      repeat
  367.            { All of the FOR/DO loops from here on are checking the ball's
  368.              boundaries and moving them accordingly }
  369.  
  370.            for m := 1 to 5 do
  371.            begin
  372.                 if (x[m] > 274) then hit[m] := 0;
  373.                 if (x[m] < 1)   then hit[m] := 1;
  374.                 if (y[m] > 186) then hitY[m]:= 0;
  375.                 if (y[m] < 1)   then hitY[m]:= 1;
  376.  
  377.                 Case hit[m] of
  378.                      1 : inc(x[m],2);
  379.                      0 : dec(x[m],2);
  380.                 end; { end case }
  381.  
  382.                 Case hitY[m] of
  383.                      1 : inc(y[m],2);
  384.                      0 : dec(y[m],2);
  385.                 end; { end case }
  386.            end;  { end for\do }
  387.  
  388.            for m := 6 to 10 do
  389.            begin
  390.                 if (x[m] > 274) then hit[m] := 0;
  391.                 if (x[m] < 1)   then hit[m] := 1;
  392.                 if (y[m] > 186) then hitY[m]:= 0;
  393.                 if (y[m] < 1)   then hitY[m]:= 1;
  394.  
  395.                 Case hit[m] of
  396.                      1 : inc(x[m],5);
  397.                      0 : dec(x[m],5);
  398.                 end; { end case }
  399.  
  400.                 Case hitY[m] of
  401.                      1 : inc(y[m],5);
  402.                      0 : dec(y[m],5);
  403.                 end; { end case }
  404.            end;  { end for\do }
  405.  
  406.            for m := 11 to 14 do
  407.            begin
  408.                 if (x[m] > 294) then hit[m] := 0;
  409.                 if (x[m] < 1)   then hit[m] := 1;
  410.                 if (y[m] > 179) then hitY[m]:= 0;
  411.                 if (y[m] < 1)   then hitY[m]:= 1;
  412.  
  413.                 Case hit[m] of
  414.                      1 : inc(x[m],5);
  415.                      0 : dec(x[m],5);
  416.                 end; { end case }
  417.  
  418.                 Case hitY[m] of
  419.                      1 : inc(y[m],5);
  420.                      0 : dec(y[m],5);
  421.                 end; { end case }
  422.            end;  { end for\do }
  423.  
  424.            for m := 15 to 18 do
  425.            begin
  426.                 if (x[m] > 294) then hit[m] := 0;
  427.                 if (x[m] < 1)   then hit[m] := 1;
  428.                 if (y[m] > 179) then hitY[m]:= 0;
  429.                 if (y[m] < 1)   then hitY[m]:= 1;
  430.  
  431.                 Case hit[m] of
  432.                      1 : inc(x[m],2);
  433.                      0 : dec(x[m],2);
  434.                 end; { end case }
  435.  
  436.                 Case hitY[m] of
  437.                      1 : inc(y[m],2);
  438.                      0 : dec(y[m],2);
  439.                 end; { end case }
  440.            end;  { end for\do }
  441.  
  442.            for m := 19 to 21 do
  443.            begin
  444.                 if (x[m] > 294) then hit[m] := 0;
  445.                 if (x[m] < 1)   then hit[m] := 1;
  446.                 if (y[m] > 179) then hitY[m]:= 0;
  447.                 if (y[m] < 1)   then hitY[m]:= 1;
  448.  
  449.                 Case hit[m] of
  450.                      1 : inc(x[m],4);
  451.                      0 : dec(x[m],4);
  452.                 end; { end case }
  453.  
  454.                 Case hitY[m] of
  455.                      1 : inc(y[m],4);
  456.                      0 : dec(y[m],4);
  457.                 end; { end case }
  458.            end;  { end for\do }
  459.  
  460.            for m := 22 to 25 do
  461.            begin
  462.                 if (x[m] > 286) then hit[m] := 0;
  463.                 if (x[m] < 1)   then hit[m] := 1;
  464.                 if (y[m] > 172) then hitY[m]:= 0;
  465.                 if (y[m] < 1)   then hitY[m]:= 1;
  466.  
  467.                 Case hit[m] of
  468.                      1 : inc(x[m],3);
  469.                      0 : dec(x[m],3);
  470.                 end; { end case }
  471.  
  472.                 Case hitY[m] of
  473.                      1 : inc(y[m],3);
  474.                      0 : dec(y[m],3);
  475.                 end; { end case }
  476.            end;  { end for\do }
  477.  
  478.  
  479.            { Update starfield }
  480.            for i:= 0 to maxstars do
  481.            begin
  482.                 inc(stars[i,1],stars[i,3]);
  483.  
  484.                 if (stars[i,1] > 199) then
  485.                 begin
  486.                      stars[i,0] := random(319);
  487.                      stars[i,1] := 0;
  488.                      stars[i,3] := random(speed) + 1;
  489.  
  490.                      case stars[i,3] of
  491.                           1 : stars[i,2] := 26 + random(5);
  492.                           2 : stars[i,2] := 23 + random(5);
  493.                      else
  494.                          stars[i,2] := 18 + random(5);
  495.                      end;  { end case }
  496.                 end;  { end for\do }
  497.  
  498.                 { Draw the stars }
  499.                 putpixel (stars[i,0], stars[i,1], stars[i,2]);
  500.  
  501.            end;  { End of star field update }
  502.  
  503.  
  504.            { Put the images on the screen!  All balls in this block will
  505.              be behind the text }
  506.            PutClip(cel1^, x[1], y[1], 15, 13);
  507.            PutClip(cel1^, x[2], y[2], 15, 13);
  508.            PutClip(cel1^, x[3], y[3], 15, 13);
  509.            PutClip(cel1^, x[4], y[4], 15, 13);
  510.            PutClip(cel1^, x[5], y[5], 15, 13);
  511.            PutClip(cel1^, x[6], y[6], 15, 13);
  512.            PutClip(cel1^, x[7], y[7], 15, 13);
  513.            PutClip(cel1^, x[8], y[8], 15, 13);
  514.            PutClip(cel1^, x[9], y[9], 15, 13);
  515.            PutClip(cel1^, x[10], y[10], 15, 13);
  516.            PutClip(cel2^, x[11], y[11], 25, 21);
  517.            PutClip(cel2^, x[12], y[12], 25, 21);
  518.            PutClip(cel2^, x[13], y[13], 25, 21);
  519.            PutClip(cel2^, x[14], y[14], 25, 21);
  520.            PutClip(cel3^, x[25], y[25], 33, 27);
  521.  
  522.            { Print our little message to the screen }
  523.            VPrint ('Q to Quit', 10, 153, 15, 255);
  524.            VPrint ('O to fade out', 10, 163, 9, 255);
  525.            VPrint ('I to fade in', 10, 173, 1, 255);
  526.            VPrint ('S to stop fade', 10, 183, 9, 255);
  527.  
  528.            { Now put somemore images to the screen, All balls in this block
  529.              will be infront of the text }
  530.            PutClip(cel2^, x[15], y[15], 25, 21);
  531.            PutClip(cel2^, x[16], y[16], 25, 21);
  532.            PutClip(cel2^, x[17], y[17], 25, 21);
  533.            PutClip(cel2^, x[18], y[18], 25, 21);
  534.            PutClip(cel2^, x[19], y[19], 25, 21);
  535.            PutClip(cel2^, x[20], y[20], 25, 21);
  536.            PutClip(cel2^, x[21], y[21], 25, 21);
  537.            PutClip(cel3^, x[22], y[22], 33, 27);
  538.            PutClip(cel3^, x[23], y[23], 33, 27);
  539.            PutClip(cel3^, x[24], y[24], 33, 27);
  540.  
  541.            { Update the mouse cursor }
  542.            MMove;
  543.  
  544.            { Now update the screen with all of our new stuff }
  545.            Update;
  546.  
  547.            { Now check for user activity }
  548.            if (keypressed) then
  549.            begin
  550.                 c := upcase(readkey);
  551.  
  552.                 case c of
  553.                      'Q': Quit := TRUE;
  554.                      'S': begin
  555.                                FOut := FALSE;
  556.                                FIn := FALSE;
  557.                           end;
  558.                      'O': begin
  559.                                FIn := FALSE;
  560.                                if (FOut) then FOut := FALSE
  561.                                   else FOut := TRUE;
  562.                           end;
  563.                      'I': begin
  564.                                FOut := FALSE;
  565.                                if (FIn) then FIn := FALSE
  566.                                   else FIn := TRUE;
  567.                           end;
  568.                 end; { end case }
  569.            end;
  570.  
  571.            If (FOut) then FadeOutStep (1, 0, 0);
  572.            If (FIn) then FadeInStep (1, 0, 0);
  573.  
  574.      until (Quit = TRUE);
  575.  
  576.      { Fade-out the screen }
  577.      FadeOut (1, 1, 0);
  578.  
  579.      { Clear both video pages }
  580.      SetWorkPage (1);
  581.      clearscreen (0);
  582.      SetWorkPage (2);
  583.      clearscreen (0);
  584. End;  { Procedure }
  585.  
  586.  
  587. { Input device demo }
  588. { - - - - - - }
  589. Procedure Input_Demo;
  590. var
  591.    Quit         : boolean;
  592.    trail        : boolean;
  593.    jLeft, jUp,
  594.    jRight, jDown: Boolean;
  595.    B1, B2       : Boolean;
  596.    oldX, oldY   : integer;
  597.  
  598. Begin
  599.      BlankPalette;
  600.  
  601.      SetWorkPage(1);
  602.  
  603.      { Load-up our images }
  604.      ShowPcx ('balls.pcx', 1, 1);
  605.  
  606.      { Get images into memory }
  607.      GetImage (cel2^, 45, 7, 25, 21);
  608.  
  609.      { Clear video page }
  610.      SetWorkPage (1);
  611.      clearscreen (0);
  612.  
  613.      { Restore palette }
  614.      RestorePalette;
  615.  
  616.      Quit := FALSE;
  617.      trail:= FALSE;
  618.      x    := 100;
  619.      y    := 100;
  620.  
  621.      { Initialize mouse driver }
  622.      MInit;
  623.  
  624.      { Make the mouse cursor visible }
  625.      MShow (1);
  626.  
  627.      { Initialize the joystick routines & calibrate the joystick }
  628.      Init_Joy;
  629.  
  630.      FlushKB;
  631.  
  632.      repeat
  633.            if (keypressed) then
  634.            begin
  635.                 key := upcase(readkey);
  636.                 if (key = 'Q') then Quit := TRUE;
  637.            end;  { end if\then }
  638.  
  639.            if (btnP<>0) then
  640.            begin
  641.                 trail:= TRUE;
  642.                 oldX := mX - 13;
  643.                 oldY := mY - 10;
  644.            end;  { end if\then }
  645.  
  646.            if (trail) then
  647.            begin
  648.                 if (x > oldX) then dec(x,5);
  649.                 if (x < oldX) then inc(x,5);
  650.                 if (y > oldY) then dec(y,5);
  651.                 if (y < oldY) then inc(y,5);
  652.  
  653.                 if (mX = x) AND (mY = y) then trail := FALSE;
  654.            end;  { end if\then }
  655.  
  656.            GetJoy (jLeft, jRight, jUp, jDown, B1, B2, B2, B2);
  657.  
  658.            if (jLeft) or (jRight) or (jUp) or (jDown) then trail := FALSE;
  659.  
  660.            if (jLeft)  then dec(x,3);
  661.            if (jRight) then inc(x,3);
  662.            if (jUp)    then dec(y,3);
  663.            if (jDown)  then inc(y,3);
  664.  
  665.  
  666.            { Put ball on screen }
  667.            PutClip (cel2^, x, y, 25, 21);
  668.  
  669.            { Show our little message }
  670.            VPrint('Use mouse/joystick and click a spot, the',0,10,1,255);
  671.            VPrint('ball will then move to that spot.',0,20,1,255);
  672.            VPrint ('Q = Quit', 10, 190, 1, 255);
  673.  
  674.            { Update mouse cursor }
  675.            MMove;
  676.  
  677.            { Check for mouse button presses }
  678.            MClick (0);
  679.  
  680.            { Update video screen }
  681.            Update;
  682.  
  683.      until (Quit);
  684.  
  685. End;  { Procedure }
  686.  
  687.  
  688. { Small little 'RPG-game' like demo }
  689. { - - - - - - }
  690. Procedure Game_SampleDemo;
  691. Var
  692.    WalkL, WalkR,
  693.    StandL, StandR: Boolean;
  694.    Quit          : Boolean;
  695.    fname         : string;
  696.    cnum,
  697.    speed         : byte;
  698.  
  699. Begin
  700.  
  701.      { Allocate some memory for our little guy }
  702.      for tmp := 1 to 8 do
  703.          new (man[tmp]);
  704.  
  705.      new (btree);
  706.  
  707.      { Set the palette to black }
  708.      BlankPalette;
  709.  
  710.      SetWorkPage(1);
  711.  
  712.      { Load-up the animation cells into memory }
  713.      for tmp := 1 to 8 do
  714.      begin
  715.           fname := 'cel000' + INT2STR(tmp) + '.pcx';
  716.  
  717.           showpcx (fname, 1, 1);
  718.           GetImage (man[tmp]^, 145, 38, 25, 39);
  719.      end;  { end for\do }
  720.  
  721.  
  722.      { Load-up the tree as we will use it later }
  723.      showpcx ('bigtree2.pcx', 1, 1);
  724.      GetImage (btree^, 1, 1, 73, 83);
  725.  
  726.      { Clear the video pages }
  727.      SetWorkPage (1);
  728.      clearscreen (0);
  729.      SetWorkPage (2);
  730.      clearscreen (0);
  731.  
  732.      { Initialize the mouse driver }
  733.      MInit;
  734.  
  735.      { Make the mouse cursor visible }
  736.      MShow (1);
  737.  
  738.      { Show message box #1 }
  739.      showpcx ('msg1b.pcx', 0, 3);
  740.  
  741.      FlushKB;
  742.  
  743.      repeat
  744.            { Update Mouse }
  745.            MMove;
  746.  
  747.            { Check for mouse clicks }
  748.            MClick(0);
  749.  
  750.            { Update display }
  751.            Update;
  752.      until ((keypressed) or (btnP<>0));
  753.  
  754.  
  755.      { Show message box #2 }
  756.      showpcx ('msg2b.pcx', 1, 3);
  757.  
  758.      FlushKB;
  759.  
  760.      repeat
  761.            { Update Mouse }
  762.            MMove;
  763.  
  764.            { Check for mouse clicks }
  765.            MClick(0);
  766.  
  767.            { Update display }
  768.            Update;
  769.      until ((keypressed) or (btnP<>0));
  770.  
  771.  
  772.      { Fade-out the palette }
  773.      FadeOut (1, 1, 0);
  774.  
  775.      { Set the palette to black }
  776.      BlankPalette;
  777.  
  778.      { Clear the video pages }
  779.      SetWorkPage (1);
  780.      clearscreen (0);
  781.      SetWorkPage (2);
  782.      clearscreen (0);
  783.  
  784.      { Load-up the background scene on both video pages }
  785.      showpcx ('demo.pcx', 1, 1);
  786.      showpcx ('demo.pcx', 1, 2);
  787.  
  788.      { Put the little guy on the screen }
  789.      PutClip (man[1]^, 100, 80, 25, 39);
  790.  
  791.      { Restore the palette }
  792.      RestorePalette;
  793.  
  794.  
  795.      x     := 100;
  796.      y     := 80;
  797.      cnum  := 1;
  798.      speed := 2;
  799.      StandL:= TRUE;
  800.      StandR:= FALSE;
  801.      WalkL := FALSE;
  802.      WalkR := FALSE;
  803.      Quit  := FALSE;
  804.  
  805.      FlushKB;
  806.      repeat
  807.            if (keypressed) then
  808.            begin
  809.                 key := readkey;
  810.  
  811.                 if (upcase(key) = 'Q') then Quit := TRUE;
  812.  
  813.                 { Increase guy's speed }
  814.                 if (key = '+') then
  815.                 begin
  816.                      inc(speed);
  817.                      if (speed > 50) then
  818.                      begin
  819.                           speed := 50;
  820.                           sound (900);
  821.                           delay (10);
  822.                           nosound;
  823.                      end;  { end if\then }
  824.                 end;  { end if\then }
  825.  
  826.                 { Decrease guy's speed }
  827.                 if (key = '-') then
  828.                 begin
  829.                      dec(speed);
  830.                      if (speed < 1) then
  831.                      begin
  832.                           speed := 1;
  833.                           sound (900);
  834.                           delay (10);
  835.                           nosound;
  836.                      end;  { end if\then }
  837.                 end;  { end if\then }
  838.  
  839.  
  840.                 { Check for extended keystroke (arrow keys) }
  841.                 if (key=chr(0)) then
  842.                 begin
  843.                      key := readkey;
  844.  
  845.                      { Right Arrow }
  846.                      if (key = #77) then
  847.                      begin
  848.                           StandL:= FALSE;
  849.                           StandR:= FALSE;
  850.                           WalkL := FALSE;
  851.  
  852.                           if (WalkR) then
  853.                           begin
  854.                                WalkR := FALSE;
  855.                                StandR:= TRUE;
  856.                           end  { end if\then }
  857.                           else WalkR := TRUE;
  858.                      end;
  859.  
  860.                      { Left Arrow }
  861.                      if (key = #75) then
  862.                      begin
  863.                           StandL:= FALSE;
  864.                           StandR:= FALSE;
  865.                           WalkR := FALSE;
  866.                           if (WalkL) then
  867.                           begin
  868.                                WalkL := FALSE;
  869.                                StandL := TRUE;
  870.                           end  { end if\then }
  871.                           else WalkL := TRUE;
  872.                      end;
  873.                 end;
  874.            end;
  875.  
  876.            if (StandL) then PutClip (man[1]^, x, y, 25, 39);
  877.            if (StandR) then FlipClip (man[1]^, x, y, 25, 39);
  878.  
  879.            if (WalkL) then
  880.            begin
  881.                 dec(x,speed);
  882.                 PutClip (man[cnum]^, x, y, 25, 39);
  883.                 inc(cnum);
  884.                 if (cnum > 8) then cnum := 1;
  885.            end;  { end if\then }
  886.  
  887.            if (WalkR) then
  888.            begin
  889.                 inc(x,speed);
  890.                 FlipClip (man[cnum]^, x, y, 25, 39);
  891.                 inc(cnum);
  892.                 if (cnum > 8) then cnum := 1;
  893.            end;  { end if\then }
  894.  
  895.            PutImage (btree^, 33, 64, 73, 83);
  896.  
  897.            { Update mouse cursor }
  898.            MMove;
  899.  
  900.            { Check for mouse button clicks }
  901.            MClick (0);
  902.  
  903.            if (btnP<>0) then
  904.            begin
  905.  
  906.                 if ((btnX < x) and (btnY<166)) then
  907.                 begin
  908.                      StandL:= FALSE;
  909.                      StandR:= FALSE;
  910.                      WalkR := FALSE;
  911.                      if (WalkL) then
  912.                      begin
  913.                           WalkL := FALSE;
  914.                           StandL := TRUE;
  915.                      end  { end if\then }
  916.                      else WalkL := TRUE;
  917.                 end;
  918.  
  919.                 if ((btnX > x) and (btnY<166)) then
  920.                 begin
  921.                      StandL:= FALSE;
  922.                      StandR:= FALSE;
  923.                      WalkL := FALSE;
  924.  
  925.                      if (WalkR) then
  926.                      begin
  927.                           WalkR := FALSE;
  928.                           StandR:= TRUE;
  929.                      end  { end if\then }
  930.                      else WalkR := TRUE;
  931.                 end;
  932.  
  933.                 if (btnX >= 272) and (btnX <= 309) then
  934.                    if (btnY >= 178) and (btnY <= 187) then Quit:=true;
  935.            end;
  936.  
  937.            { Update the video screen }
  938.            Update;
  939.  
  940.      until (Quit);
  941.  
  942.      FadeOut (1, 1, 0);
  943.  
  944.      { Clear the video pages }
  945.      SetWorkPage (1);
  946.      clearscreen (0);
  947.      SetWorkPage (2);
  948.      clearscreen (0);
  949.  
  950.      { Restore the palette }
  951.      RestorePalette;
  952.  
  953.  
  954.      { Free the memory we allocated earlier }
  955.      dispose (btree);
  956.  
  957.      for tmp := 1 to 8 do
  958.          dispose (man[tmp]);
  959.  
  960. End;  { Procedure }
  961.  
  962.  
  963. { Font demo }
  964. { - - - - - - }
  965. Procedure Font_Demo;
  966. var
  967.   Quit          : Boolean;
  968.   underline,
  969.   doublehigh,
  970.   doublewide,
  971.   italics       : Boolean;
  972.   whichfont     : longint;
  973.  
  974. Begin
  975.      { Clear both video pages }
  976.      SetWorkPage (1);
  977.      clearscreen (0);
  978.      SetWorkPage (2);
  979.      clearscreen (0);
  980.  
  981.      SetWorkPage(1);
  982.  
  983.      whichfont := 0;
  984.      underline := FALSE;
  985.      italics   := FALSE;
  986.      doublewide:= FALSE;
  987.      doublehigh:= FALSE;
  988.  
  989.  
  990.      { Load-up the first font }
  991.      LoadFont ('fonts.bin', whichfont);
  992.  
  993.  
  994.      SetRGB(9,9,40,9);
  995.      Quit := FALSE;
  996.      repeat
  997.            { Print our little message, BTW VPrint uses regular BIOS text
  998.              font, whereas FontPrint uses one of the 30 fonts in VGFX }
  999.            VPrint ('Up\down arrow keys to cycle fonts:', 10, 5, 1, 255);
  1000.            VPrint ('Toggles: U-underline,  I-italics', 10, 20, 12, 255);
  1001.            VPrint ('         W-doublewide, H-doublehigh', 10, 30, 12, 255);
  1002.            VPrint ('Q = Quit', 10, 190, 1, 255);
  1003.  
  1004.  
  1005.            { Set the font 'style' (enhancment) }
  1006.            FontStyle (underline, italics, doublewide, doublehigh);
  1007.  
  1008.            { Print some text using the current font }
  1009.            FontPrint ('This is the '+FontNames[whichfont]+' font!',10, 50, 9);
  1010.            FontPrint ('1234567890!&*()+-\/[]{}',10, 110, 9);
  1011.  
  1012.            { Update the display }
  1013.            Update;
  1014.  
  1015.            key := UpCase(readkey);
  1016.  
  1017.            if (key = 'Q') then Quit := TRUE;
  1018.  
  1019.            { Check to see if the user has changed the font style }
  1020.            Case (Key) of
  1021.                 'U': If (underline) then underline := FALSE
  1022.                       else underline := TRUE;
  1023.  
  1024.                 'I': If (italics) then italics := FALSE
  1025.                       else italics := TRUE;
  1026.  
  1027.                 'W': If (doublewide) then doublewide := FALSE
  1028.                       else doublewide := TRUE;
  1029.  
  1030.                 'H': If (doublehigh) then doublehigh := FALSE
  1031.                       else doublehigh := TRUE;
  1032.            End;  { end case }
  1033.  
  1034.  
  1035.            { Check to see if the user is cycling through the fonts }
  1036.            if (key = chr(0)) then
  1037.            begin
  1038.                 Case (ReadKey) Of
  1039.                      #80 : begin
  1040.                                 dec(whichfont);
  1041.                                 if (whichfont < 0) then whichfont := 30;
  1042.                                 LoadFont ('fonts.bin', whichfont);
  1043.                            end;
  1044.                      #72 : begin
  1045.                                 inc(whichfont);
  1046.                                 if (whichfont > 30) then whichfont := 0;
  1047.                                 LoadFont ('fonts.bin', whichfont);
  1048.                            end;
  1049.                 end;  { end case }
  1050.            end;  { end if\then }
  1051.  
  1052.            { Let the user know what font styles are active }
  1053.            if (underline) then VPrint ('U', 10, 180, 1, 255);
  1054.            if (italics) then VPrint ('I', 20, 180, 1, 255);
  1055.            if (doublewide) then VPrint ('W', 30, 180, 1, 255);
  1056.            if (doublehigh) then VPrint ('H', 40, 180, 1, 255);
  1057.  
  1058.      until (Quit);
  1059.  
  1060.  
  1061.      { Fade-out the palette }
  1062.      FadeOut (1, 1, 0);
  1063.  
  1064.      { Clear the video pages }
  1065.      SetWorkPage (1);
  1066.      clearscreen (0);
  1067.      SetWorkPage (2);
  1068.      clearscreen (0);
  1069. End;  { Procedure }
  1070.  
  1071.  
  1072.  
  1073. { ************************** }
  1074. {      Main Procedure        }
  1075. { ************************** }
  1076. Begin
  1077.      { Tell VGFX to use DEMO.GFX for all it's file handling }
  1078.      if (not SetWorkLib ('demo.gfx')) then
  1079.      begin
  1080.           writeln;
  1081.           writeln('Sorry, but I cannot find DEMO.GFX, this file is required for the demo!');
  1082.           writeln;
  1083.           halt(1);
  1084.      end;
  1085.  
  1086.      { Initialize SoundBlaster or compatible }
  1087.      if (not SB_Init(5, 1, $220)) then
  1088.      begin
  1089.           writeln;
  1090.           writeln('Sorry, but I cannot find a SoundBlaster or compatible ...');
  1091.           writeln;
  1092.           writeln('So you''re gonna have to see this demo and not hear it!');
  1093.           writeln;
  1094.           write('Press any key to continue ...');
  1095.           readkey;
  1096.      end
  1097.      else
  1098.      begin
  1099.           { Load VOC file into memory }
  1100.           if (not LoadVoc('song.voc')) then
  1101.           begin
  1102.                writeln;
  1103.                writeln('Not enough free memory or file not found, sound will be disabled!');
  1104.                writeln;
  1105.                write('Press any key to continue ...');
  1106.                readkey;
  1107.           end
  1108.           else
  1109.           begin
  1110.                { Tell the VOC routines to loop the sound forever
  1111.                  with a 2 second delay between loops }
  1112.                LoopVoc(TRUE, 36);
  1113.           end;
  1114.      end;
  1115.  
  1116.  
  1117.      { Initialize VGFX }
  1118.      VGFX_Init;
  1119.  
  1120.  
  1121.      { Allocate memory }
  1122.      New (cel1);
  1123.      New (cel2);
  1124.      New (cel3);
  1125.  
  1126.  
  1127.      { Play VOC file, assuming the SoundBlaster was initialized; if not
  1128.        it will do nothing }
  1129.      PlayVoc;
  1130.  
  1131.  
  1132.      { Set Palette to Black }
  1133.      BlankPalette;
  1134.  
  1135.      { Load-up our intro screen }
  1136.      showpcx ('intro.pcx', 1, 1);
  1137.  
  1138.      { Fade-in the palette }
  1139.      FadeIn (1, 1, 0);
  1140.  
  1141.      FlushKB;
  1142.      readkey;
  1143.  
  1144.      { Do the demos! }
  1145.      Ball1;
  1146.      Ball2;
  1147.      Input_Demo;
  1148.      Game_SampleDemo;
  1149.      Font_Demo;
  1150.  
  1151.  
  1152.      { Free the memory we allocated earlier }
  1153.      Dispose (cel3);
  1154.      Dispose (cel2);
  1155.      Dispose (cel1);
  1156.  
  1157.  
  1158.      { Shut-down VGFX and clean up it's mess }
  1159.      VGFX_Done;
  1160. End.  { Program }
  1161.